Libris Britannia 4/science library(b).zip/science library(b)/TECHNICA/AUTOCAD/3078A.ZIP/PGPG0991.ZIP/PGPG.LSP

Text File | 1991-09-02 | 17KB | 2 lines

(PRINC"\nParaDraft Shareware Version, Copyright (c) 1991 ParaWare Systems.,India")(PRINC"\nLoading Parent Geometry Specification Program\nPlease wait...")(SETVAR"cmdecho"0)(COMMAND"osnap""")(SETQ *PG-LANGUAGE*"english")(DEFUN QGj()(COMMAND"undo""e")(COMMAND"U")(COMMAND"U"))(DEFUN QG@()(COMMAND"undo""g"))(DEFUN QGQ(QGl)(COMMAND"COPY"QGl""(quote (0 0))(quote (0 0))))(DEFUN QG&(QGl)(COMMAND"erase"QGl""))(DEFUN QG1(QG# QG0 / QG$)(COMMAND"CHANGE")(FOREACH QG$ QG#(COMMAND QG$))(COMMAND"""P""Color")(COND((= QG0"BYLAYER")(COMMAND"BYLAYER"""))(QG0(COMMAND"RED"""))(T(COMMAND"MAGENTA"""))))(DEFUN QGO(QG| QG%)(COMMAND"INSERT"(STRCAT QG|"REFPT")QG% 1.0 1.0 0.0))(DEFUN QG?j()(COMMAND"handles""on"))(DEFUN QGjj(QG| QG@j QGQj / QGlj QG&j QG1j QG#j)(SETQ QGlj"Pan")(PRINC"\nZoom into the parent geomtry for creation of slide")(WHILE(/= QGlj"Exit")(INITGET"Window In Out Pan Exit")(SETQ QGlj(GETKWORD"\nZoom\nWindow/In/Out/Pan/Exit <Exit> : "))(COND((= QGlj"Out")(INITGET 1)(SETQ QG&j(GETPOINT"\nCenter point: "))(COMMAND"zoom""c"QG&j"0.5x"))((= QGlj"In")(INITGET 1)(SETQ QG&j(GETPOINT"\nCenter point: "))(COMMAND"zoom""c"QG&j"2x"))((= QGlj"Window")(PRINC"\nWindow: ")(INITGET 1)(SETQ QG&j(GETPOINT"\nFirst corner: "))(INITGET 1)(SETQ QG1j(GETCORNER QG&j"\nSecond corner: "))(COMMAND"zoom""w"QG&j QG1j))((= QGlj"Pan")(PRINC"\nPan: ")(INITGET 1)(SETQ QG&j(GETPOINT"\nFirst point: "))(INITGET 1)(SETQ QG1j(GETPOINT QG&j"\nSecond point: "))(COMMAND"PAN"QG&j QG1j))((= QGlj"Exit")(COMMAND"REGEN"))((NULL QGlj)(SETQ QG#j NIL)(SETQ QGlj"Exit"))(T(SETQ QG#j QGlj)(SETQ QGlj"Exit"))))(SETQ QG0j(/(GETVAR"viewsize")40.0))(COMMAND"STYLE"""""QG0j 1.0 0.0"""""")(COMMAND"DIM1""UPDATE"QGQj"")(COMMAND"text""m"(DELTA(GETVAR"viewctr")0.0(-(/(GETVAR"viewsize")2)(* 2 QG0j)))0.0(STRCAT"ParaDraft! Slide file for "QG@j))(COMMAND"mslide"(STRCAT QG| QG@j))(COMMAND"erase""l""")(COMMAND"color""BYLAYER"))(DEFUN QG$j(QGOj)(PRINC QGOj)(MODE 0)(PRINC))(SETQ *ERROR* QG$j)(DEFUN MODE(QG|j / QG%j)(IF(NOT QG?@)(SETQ QG?@(quote ("highlight""blipmode""osmode""snapmode""cmdecho""attdia""filletrad"))))(IF(ZEROP QG|j)(PROGN(IF(NOT QGj@)(SETQ QGj@(MAPCAR(quote GETVAR)QG?@)))(FOREACH QG%j QG?@(IF(EQ(TYPE(GETVAR QG%j))(quote INT))(SETVAR QG%j 0)))(SETVAR"filletrad"0.0))(PROGN(IF QGj@(MAPCAR(quote SETVAR)QG?@ QGj@))(SETQ QGj@ NIL))))(DEFUN DELTA(QG@@ QGQ@ QGl@)(LIST(+ QGQ@(CAR QG@@))(+ QGl@(CADR QG@@))))(DEFUN GETVAL(QGOj QG&@ / QG1@)(PRINC QGOj)(PRINC"<")(PRINC QG&@)(PRINC"> : ")(SETQ QG#@(TYPE QG&@))(COND((= QG#@(quote STR))(SETQ QG1@(GETSTRING))(IF(= QG1@"")(SETQ QG1@ NIL)))((= QG#@(quote INT))(SETQ QG1@(GETINT)))((= QG#@(quote REAL))(SETQ QG1@(GETREAL))))(IF QG1@(SETQ QG1@ QG1@)(SETQ QG1@ QG&@)))(DEFUN C:PARENT(/ QG0@ QG$@ QGQj QGO@ QG@j QG|@ QG%@ QG$ QG?Q QGjQ QG@Q QGQQ QGlQ QG&Q QG% QG1Q QG#Q QG| QG0Q)(SETQ QG| *PGPG-DIR*)(SETQ QG$Q 0)(SETQ QGOQ 0)(IF *PGPG-10*(QG?j))(MODE 0)(SETQ QG|Q NIL)(PRINC"\n")(COMMAND"shell"(STRCAT"type "QG|"parent.beg"))(GETPOINT"\nPress return to continue....")(SETQ QG0Q(GETVAR"viewsize"))(COND((< 400.0 QG0Q)(PRINC"\nError: Please note that the geometry should be contained ")(PRINC"\nin  a   box  of about   200x200  units  for  ParaDraft  to  work.  ")(PRINC"\nFrom the ZOOM window it appears to be too big.")(PRINC"\nPlease scale down the geometry, using SCALE command."))((> 100.0 QG0Q)(PRINC"\nError: Please note that the geometry should be contained ")(PRINC"\nin  a  box  of about  200x200  units  for  ParaDraft  to  work.  ")(PRINC"\nFrom the ZOOM window it appears to be too small.")(PRINC"\nPlease scale up the geometry, using SCALE command."))((QG%Q)(PRINC"\nPlease set the current layer correctly"))(T(GC)(QG@)(SETQ QG@j(QG?l))(SETQ QG0@(GETSTRING T"\n Description of the geometry: "))(SETQ QG$@(OPEN(STRCAT QG| QG@j".PG")"w"))(SETQ QG%(QGjl QG$@ QG@j QG0@ QG|))(SETQ *FILE-HAND* QG$@)(QG@l QG$@"type""geomtry")(QG@l QG$@"language"*PG-LANGUAGE*)(QG@l QG$@"dimlayer"(STRCASE *DIM-LAYER*"l"))(QG@l QG$@"cenlayer"(STRCASE *CEN-LAYER*"l"))(SETQ QGQj(QGQl QG$@ QG@j))(QGll QG$@)(QG&l QG$@"over")(CLOSE QG$@)(PRINC"\n The  parent geomtry information created.\n")(QGjj QG| QG@j QGQj)(COMMAND"wblock"(STRCAT *PGPG-DIR*"HELP\\"QG@j)""QG% QGQj"")(TEXTSCR)(IF(/="NONE"*PGPG-SHELL*)(QG1l QG@j)(PROGN(PRINC"\n Quit AutoCAD and run PgPg! from ")(PRINC QG|)(PRINC" directory")(PRINC"\nPlease use the following command: ")(PRINC"\nPGPG ")(PRINC QG@j)))(MODE 1)(PRINC"\nUsing UNDO command to get the drawing to the original status")(QGj)(PRINC)))(PRINC))(DEFUN QG%Q(/ QG#l)(SETQ QG#l(GETVAR"CLAYER"))(WHILE(OR(= QG#l *DIM-LAYER*)(= QG#l *CEN-LAYER*))(PRINC"\nCurrent layer may not be same as dimensioning or center line layer")(SETQ QG#l(SEL-LAYER" current layer"QG#l))(COMMAND".layer""S"QG#l""))(SETQ QG#l NIL))(DEFUN QG?l(/ QG0l QG$l)(SETQ QG$l NIL)(WHILE(NOT QG$l)(SETQ QG0l(GETVAL"\n Enter the parent geomtry name :"(GETVAR"dwgname")))(SETQ QG0l(STRCASE QG0l))(SETQ QG$l(NOT(FINDFILE(STRCAT *PGPG-DIR* QG0l".lsp"))))(IF(NOT QG$l)(PROGN(PRINC"\nError: Can not overwrite an existing application.")(PRINC"\nSorry, an application of this name already exists: ")(PRINC QG0l))))(SETQ QG0l QG0l))(PRINC"Countdown: 9")(DEFUN QG1l(QGOl / QG|l)(SETQ QG|l(OPEN(STRCAT *PGPG-DIR*"execit.bat")"w"))(PRINC"echo off\n"QG|l)(PRINC(STRCAT"cd > "*PGPG-DIR*"return\n")QG|l)(PRINC(STRCAT *PGPG-DIR*"setpath "(SUBSTR *PGPG-DIR* 1(-(STRLEN *PGPG-DIR*)1))"\n")QG|l)(PRINC(STRCAT"pgpg "QGOl"\n")QG|l)(PRINC"pause \n"QG|l)(PRINC"cls \n"QG|l)(PRINC"type parent.end\n"QG|l)(PRINC"pause \n"QG|l)(PRINC"setpath < return\n"QG|l)(CLOSE QG|l)(COMMAND *PGPG-SHELL*(STRCAT *PGPG-DIR*"execit.bat")))(DEFUN QG%l()(GETVAL"\Enter geometry name: "QG?&))(DEFUN QGj&(QGOj QG@&)(GETPOINT(STRCAT"Break at "QGOj" : ")))(TRACE QGj&)(DEFUN QGQ&(QGl&)(* QGl& 57.2957795))(DEFUN QG&&(QG1& / QG#& QG?Q QG0& QG$& QG&@)(SETQ QG0&(STRLEN QG1&))(SETQ QG?Q QG0&)(SETQ QG&@ 0)(SETQ QG#& 1)(WHILE(> QG?Q 0)(SETQ QG$&(ASCII(SUBSTR QG1& QG?Q 1)))(IF(< QG$& 60)(SETQ QG$&(- QG$& 48))(SETQ QG$&(+ 10(- QG$& 65))))(SETQ QG&@(+ QG&@(* QG$& QG#&)))(SETQ QG#&(* 16 QG#&))(SETQ QG?Q(1- QG?Q)))(SETQ QG&@ QG&@))(DEFUN QGO&(QG|& / QG$)(COND((=(TYPE QG|&)(quote ENAME))(SETQ QG$ QG|&))(T(SETQ QG$(HANDENT QG|&))))(IF QG$(SETQ QG$ QG$)(PROGN(PRINC"\n NULL Entity given ")(*ERROR*"BLK-EN aborting"))))(DEFUN QG%&(QG|& / QG?1)(COND((=(TYPE QG|&)(quote ENAME))(SETQ QG?1(QGj1(ENTGET QG|&)QG@1)))(T(SETQ QG?1 QG|&)))(SETQ QG?1 QG?1))(DEFUN QGQ1(QG|& QGl1 / QG$ QG&1)(SETQ QG$(QGO& QG|&))(WHILE(/= QGl1(QGj1(SETQ QG&1(ENTGET QG$))QG11))(SETQ QG$(ENTNEXT QG$)))(QGj1 QG&1 QG#1))(SETQ QG@1 5)(SETQ QG11 2)(SETQ QG#1 1)(SETQ QG01(quote (10 11)))(SETQ QG$1 50)(DEFUN QGO1(QG|&)(ENTGET(HANDENT QG|&)))(DEFUN QGj1(QG@Q QG|1)(CDR(ASSOC QG|1 QG@Q)))(DEFUN QG%1(QG@Q QG|1 QG?#)(SUBST(CONS QG|1 QG?#)(ASSOC QG|1 QG@Q)QG@Q))(DEFUN QGj#(QG|& QG@# / QG@& QGOl)(SETQ QG@&(ENTGET QG|&))(IF(=(QGj1 QG@& 0)"INSERT")(IF(NOT(MEMBER(QGj1 QG@& 2)QG@#))(SETQ QG@& NIL))(SETQ QG@& NIL))(SETQ QG@& QG@&))(PRINC"8")(DEFUN QG&l(QGQ# QG&@ / QG|j)(PRINC"\n"QGQ#)(QGl# QGQ# QG&@))(DEFUN QGl#(QGQ# QG&@ / QG|j)(COND((NULL QG&@)(PRINC"'default'."QGQ#))((LISTP QG&@)(SETQ QG&@(LIST(CAR QG&@)(CADR QG&@)))(FOREACH QG|j QG&@(PRINC QG|j QGQ#)(PRINC".\n"QGQ#)))(T(IF(=(TYPE QG&@)(quote STR))(PROGN(PRINC"'"QGQ#)(PRINC QG&@ QGQ#)(PRINC"' "QGQ#))(PRINC QG&@ QGQ#))(PRINC"."QGQ#))))(DEFUN QG&#(QGQ# QG@Q QG1# QGOl / QG?Q QG&@ QG|j QG#Q QG$)(SETQ QG$(CDR(ASSOC -1 QG@Q)))(SETQ QG#Q(CDR(ASSOC 8 QG@Q)))(QG## QG@Q QG#Q)(QG0# QGQ# QG$ QG@Q QG1# QGOl QG#Q))(DEFUN QG0#(QGQ# QG$ QG@Q QG1# QGOl QG#Q / QG&@)(IF QGOl(PROGN(QG&l QGQ#(STRCASE(CDR(ASSOC 0 QG@Q))"l"))(QG&l QGQ#(QG&&(CDR(ASSOC 5 QG@Q))))(QG&l QGQ#(STRCASE QG#Q"l"))))(FOREACH QG?Q QG1#(SETQ QG&@(CDR(ASSOC QG?Q QG@Q)))(IF(NULL QG&@)(SETQ QG&@"default"))(IF(LISTP QG&@)(PROGN(QG&l QGQ#(TRANS QG&@ QG$ 1)))(QG&l QGQ# QG&@)))(SETQ QG&@ T))(DEFUN QG@l(QGQ# QG$# QG?#)(QG&l QGQ#"flags")(PRINC"\n"QGQ#)(PRINC(STRCASE QG$#"l")QGQ#)(PRINC" is "QGQ#)(QGl# QGQ# QG?#)(PRINC"\n"QGQ#))(DEFUN QGO#(QGOl QG% QGQ#)(PRINC QGOl QGQ#)(PRINC".\n"QGQ#)(PRINC(CAR QG%)QGQ#)(PRINC" .\n"QGQ#)(PRINC(CADR QG%)QGQ#)(PRINC" .\n"QGQ#))(DEFUN QG|#(QGQ# QG$ QG%)(PRINC" \n"QGQ#)(SETQ QG%(TRANS QG% QG$ 1))(PRINC(CAR QG%)QGQ#)(PRINC" .\n"QGQ#)(PRINC(CADR QG%)QGQ#)(PRINC" .\n"QGQ#))(DEFUN QG##(QG@Q QG#Q)(IF(AND(= QG#Q *CEN-LAYER*)(=(CDR(ASSOC 0 QG@Q))"LINE"))(SETQ QG$Q(1+ QG$Q))))(DEFUN QG%#(QG?0 QGj0 / QG@0 QGQ0)(WHILE(PROGN(WHILE(NULL(SETQ QG@0(ENTSEL QG?0)))(PRINC"\nYou must select an entity"))(SETQ QGQ0(ENTGET(CAR QG@0)))(/=(QGj1 QGQ0 0)QGj0))(PRINC"\nEntity selected is not a ")(PRINC QG&Q))(SETQ QGQ0 QGQ0))(DEFUN QGl0(QGQ# / QG% QG&0 QG@Q QG10 QG#0 QG00 QG$0 QGO0 QG|0)(SETQ QG@Q(QG%#"\n Show a center line as the  axis of symmetry: ""LINE"))(PRINC"\nsymmetry"QGQ#)(PRINC".\n"QGQ#)(QG&# QGQ# QG@Q(quote (10 11))NIL)(REDRAW(QGj1 QG@Q -1)3)(PRINC"\nShow the range of influence for this axis of symmetry: ")(INITGET 1)(SETQ QG00(GETPOINT"\nFirst corner: "))(INITGET 1)(SETQ QG$0(GETCORNER QG00"\nOther corner: "))(PRINC"\n"QGQ#)(SETQ QGO0(LIST(MIN(CAR QG00)(CAR QG$0))(MIN(CADR QG00)(CADR QG$0))))(SETQ QG|0(LIST(MAX(CAR QG00)(CAR QG$0))(MAX(CADR QG00)(CADR QG$0))))(QGO#"lower"QGO0 QGQ#)(QGO#"upper"QG|0 QGQ#))(DEFUN QG%0(QGQ# QG@Q QG?$ QGj$ QGlQ / QG@$ QGOl QGQ$)(SETQ QG?$(1+ QG?$))(SETQ QG@$(QGj1 QG@Q 1))(QGl$(QG%1 QG@Q 1(STRCASE(STRCAT QGj$(ITOA QG?$)))))(IF(OR(= QG@$"")(NOT QGlQ))(SETQ QG@$"?")(IF(LISTP QGlQ)(IF(CAR QGlQ)(PROGN(PRINC"\nFor the dimension ")(PRINC(STRCAT QGj$(ITOA QG?$)))(SETQ QG@$(QG&$ QG@$)))(SETQ QG@$(STRCAT"?"QG@$)))(PROGN(PRINC"\nFor the dimension ")(PRINC(STRCAT QGj$(ITOA QG?$)))(SETQ QG@$(QG&$ QG@$)))))(SETQ QGOl(STRCAT QGj$(ITOA QG?$)":"QG@$))(QG&l QGQ# QGOl)(SETQ QG?$ QG?$))(DEFUN QG1$(QGQ# QG@Q QG?$ QGlQ / QG#$)(SETQ QG#$(QGj1 QG@Q 70))(IF(>= QG#$ 128)(SETQ QG#$(- QG#$ 128)))(COND((= QG#$ 1)(QG&l QGQ#"aligned")(QG&l QGQ#(QG&&(CDR(ASSOC 5 QG@Q))))(SETQ QG?$(QG%0 QGQ# QG@Q QG?$"L"QGlQ))(QG&# QGQ# QG@Q(quote (13 14 11))NIL))((= QG#$ 2)(QG&l QGQ#"angular")(QG&l QGQ#(QG&&(CDR(ASSOC 5 QG@Q))))(SETQ QG?$(QG%0 QGQ# QG@Q QG?$"%%d"QGlQ))(QG&# QGQ# QG@Q(quote (13 14 10 15 16))NIL))((= QG#$ 3)(QG&l QGQ#"diameter")(QG&l QGQ#(QG&&(CDR(ASSOC 5 QG@Q))))(SETQ QG?$(QG%0 QGQ# QG@Q QG?$"%%c"QGlQ))(QG&# QGQ# QG@Q(quote (15 10))NIL))((= QG#$ 4)(QG&l QGQ#"radius")(QG&l QGQ#(QG&&(CDR(ASSOC 5 QG@Q))))(SETQ QG?$(QG%0 QGQ# QG@Q QG?$"R"(LIST QGlQ)))(QG&# QGQ# QG@Q(quote (15 10))NIL))(T(QG&l QGQ#"dimension")(QG&l QGQ#(QG&&(CDR(ASSOC 5 QG@Q))))(SETQ QG?$(QG%0 QGQ# QG@Q QG?$"L"QGlQ))(QG&# QGQ# QG@Q(quote (13 14 50 11))NIL)))(IF QGlQ(QG&l QGQ#"include")(QG&l QGQ#"remove"))(SETQ QG?$ QG?$))(DEFUN QG0$(QG@j QG?Q)(STRCAT QG@j(ITOA QG?Q)))(DEFUN QG$$(QGOl QG?0 / QG&@)(SETQ QGOl QGOl))(DEFUN QGjl(QGQ# QG@j QG0@ QG| / QG$@ QGQj QGO@ QGlj QGO$ QG|$ QG%$ QG?O QGjO QG|@ QG%@ QG$ QG?Q QGjQ QG@Q QGQQ QGlQ QG&Q QG% QG1Q QG#Q QG&j QG1j)(PRINC"\n$"QGQ#)(PRINC QG0@ QGQ#)(PRINC"$.\n"QGQ#)(QG@l QGQ#"layer"(GETVAR"CLAYER"))(QG@l QGQ#"handles""on")(QG@l QGQ#"user"(QG$$"USER""user name"))(GRAPHSCR)(INITGET 1)(SETQ QG%(GETPOINT(STRCAT"\nInsertion point for "QG@j": ")))(QGO#"refpt"QG% QGQ#)(QGO QG| QG%)(SETQ QG|$(/(GETVAR"viewsize")2))(SETQ QG%$(GETVAR"viewctr"))(SETQ QGjO(GETVAR"screensize"))(SETQ QG?O(/(CAR QGjO)(CADR QGjO)))(SETQ QGO$(* QG|$ QG?O))(QGO#"vsmin"(DELTA QG%$(- QGO$)(- QG|$))QGQ#)(QGO#"vsmax"(DELTA QG%$ QGO$ QG|$)QGQ#)(SETQ QG% QG%))(PRINC"7")(DEFUN QGQl(QGQ# QG@j / QG0@ QG$@ QGQj QGO@ QG|@ QG%@ QG$ QG?Q QGjQ QG@Q QGQQ QGlQ QG&Q QG% QG1Q QG#Q)(PRINC"\n Select the entities making up geomtry : ")(PRINC QG@j)(SETVAR"highlight"1)(WHILE(NOT(SETQ QGQj(SSGET)))(PRINC"\n Select the entities making up geomtry : ")(PRINC QG@j))(SETQ QG|@ 0)(IF(NOT(NULL QGQj))(SETQ QG|@(SSLENGTH QGQj)))(SETQ QGO@(QG@O"\n Select the dimensions to be drawn"))(SETVAR"highlight"0)(IF(/= QG|@ 0)(PRINC"\n Processing the parent geomtry information.\n "))(SETQ QG?Q(- QG|@ 1))(SETQ QG%@ 0)(SETQ QG?$ 0)(WHILE(>= QG?Q 0)(SETQ QG$(SSNAME QGQj QG?Q))(SETQ QG?Q(- QG?Q 1))(SETQ QG@Q(QGQO QG$))(SETQ QG&Q(CDR(ASSOC 0 QG@Q)))(SETQ QG%@(ENTER-GEOM QGQ# QG$ QG&Q QG@Q QGO@ QG%@))(PRINC"\15")(PRINC(1-(- QG|@ QG?Q)))(PRINC"  entities processed out of ")(PRINC QG|@)(PRINC" selected entities.    "))(PRINC"\nTotal ")(PRINC QG%@)(PRINC" entities written.")(SETQ QGQj QGQj))(PRINC"6")(DEFUN QGll(QGQ# / QG|@ QG?0)(SETQ QG|@ 0)(PRINC"\n You have ")(PRINC QG$Q)(PRINC" center lines in the geometry, which imply symmetry.")(SETQ QG?0"\n Is there any symmetry in the geometry (Yes/No) ?")(WHILE(PROGN(INITGET 1"Yes No")(="Yes"(GETKWORD QG?0)))(SETQ QG|@(1+ QG|@))(QGl0 QGQ#)(SETQ QG?0"\nAny other symmetry in the geometry (Yes/No) ?"))(PRINC"\nYou have defined ")(PRINC QG|@)(PRINC" symmetry regions "))(DEFUN QGlO(QG&O / QGQ# QG1O)(SETQ QGQ#(OPEN(STRCAT QG&O".scr")"w"))(PRINC"setvar cmdecho 0\n"QGQ#)(SETQ QG1O NIL)(SETQ QGQ# QGQ#))(DEFUN QG#O(QGQ#)(PRINC"(textscr)\n"QGQ#)(PRINC".QUIT\nY"QGQ#)(CLOSE QGQ#))(DEFUN QG0O(QG$O QGQ#)(WHILE(NOT(NULL(CDR QG$O)))(PRINC(CAR QG$O)QGQ#)(SETQ QG$O(CDR QG$O))(PRINC","QGQ#))(PRINC(CAR QG$O)QGQ#))(DEFUN QGOO(QG|O QG%O / QGQ# QG$@)(SETQ QGQ# QG$@)(IF(=(SUBSTR QG|O 1 1)":")(PRINC(STRCAT"(load \""(SUBSTR QG|O 2)"\")")QGQ#)(PRINC QG|O QGQ#))(PRINC"\n Doing...")(PRINC QG|O)(FOREACH QG$O QG%O(PRINC"\n"QGQ#)(IF(ATOM QG$O)(PRINC QG$O QGQ#)(QG0O QG$O QGQ#)))(PRINC"\n"QGQ#))(DEFUN QGj1(QG@Q QG|1)(CDR(ASSOC QG|1 QG@Q)))(DEFUN QG&&(QG1& / QG#& QG?Q QG0& QG$& QG&@)(SETQ QG0&(STRLEN QG1&))(SETQ QG?Q QG0&)(SETQ QG&@ 0)(SETQ QG#& 1)(WHILE(> QG?Q 0)(SETQ QG$&(ASCII(SUBSTR QG1& QG?Q 1)))(IF(< QG$& 60)(SETQ QG$&(- QG$& 48))(SETQ QG$&(+ 10(- QG$& 65))))(SETQ QG&@(+ QG&@(* QG$& QG#&)))(SETQ QG#&(* 16 QG#&))(SETQ QG?Q(1- QG?Q)))(SETQ QG&@ QG&@))(DEFUN QG?|(QG$ / QGj| QG@|)(SETQ QGj|(SSADD))(SETQ QGj|(QGQ| QGj| QG$)))(DEFUN QGQ|(QGj| QG$ / QG@|)(IF(SETQ QG@|(ENTNEXT QG$))(QGQ| QGj| QG@|))(SSADD QG$ QGj|)(SETQ QGj| QGj|))(DEFUN QGl|(QG$ / QG@Q QG&Q QG?1)(SETQ QG@Q(ENTGET QG$))(SETQ QG&Q(CDR(ASSOC 0 QG@Q)))(SETQ QG?1(CDR(ASSOC 5 QG@Q)))(PRINC QG&Q QGQ#)(PRINC"  =>  "QGQ#)(PRINC QG?1 QGQ#))(DEFUN QG&|(QG$)(IF(NULL QG$)(CONS 0"NULL")(QGQO QG$)))(DEFUN QG1|(QG$ / QG@Q)(SETQ QG@Q(QG&| QG$))(CDR(ASSOC 0 QG@Q)))(DEFUN QG#|()(TEXTSCR))(DEFUN QG0|(QG|)(COMMAND"shell"(STRCAT"type "QG|"parent.msg"))(GETPOINT"\nPress return to continue....")(PRINC))(DEFUN QG$|(QG|)(COMMAND"shell"(STRCAT"type "QG|"parent.end"))(GETPOINT"\nPress return to continue....")(PRINC))(DEFUN QGO|(QG|j)(SETQ QG|j QG|j))(DEFUN QGQO(QG$)(SETQ QGOQ(1+ QGOQ))(CONS(CONS 5 QGOQ)(ENTGET QG$)))(DEFUN QGl$(QG@Q / QG0l)(SETQ QG0l(CAR QG@Q))(IF(=(CAR QG0l)5)(ENTMOD(CDR QG@Q))(PROGN(PRINC"\nproblem found")(PRINC QG@Q))))(DEFUN C:PGPG(/ QG||)(PRINC"\nParent Geometry Specification Program is already loaded")(PRINC))(DEFUN C:PGPGSET(/ QG||)(TEXTSCR)(PRINC"\nParent Geometry Specification Program Settings:")(INITGET 1"Layer PGPG eXit")(SETQ QG||(GETKWORD"\nLayer names/PgPg! running method/eXit: "))(COND((= QG||"Layer")(QG%|))((= QG||"PGPG")(TEXTSCR)(PRINC"\nPgPg can be executed! independently afterwards,")(PRINC"\n     or called automatically by PARENT command.")(IF(= *PGPG-SHELL*"NONE")(PRINC"\nPresently PgPg! must be executed independently.")(PRINC(STRCAT"\nPresent command setting is "*PGPG-SHELL*)))(PRINC"\nEnter NONE to executed PgPg! independently.")(SETQ *PGPG-SHELL*(GETVAL"\nEnter command name: "*PGPG-SHELL*))(IF(= *PGPG-SHELL*"NONE")(PRINC"\nNow PgPg! must be executed independently.")(PRINC(STRCAT"\nNow command setting is "*PGPG-SHELL*))))(T(PRINC)))(PRINC))(DEFUN QG%|(/ QG||)(PRINC"\nSet layer:")(INITGET 1"Dimlayer Centerlayer")(SETQ QG||(GETKWORD"Center-line/Dimension: "))(COND((= QG||"Dimlayer")(SETQ *DIM-LAYER*(SEL-LAYER" dimensioning layer"*DIM-LAYER*)))((= QG||"Centerlayer")(SETQ *CEN-LAYER*(SEL-LAYER" center line layer"*CEN-LAYER*))))(PRINC))(DEFUN SEL-LAYER(QGOj QG?% / QG$)(PRINC"\nPresent ")(PRINC QGOj)(PRINC" is : ")(PRINC QG?%)(SETQ QG$ NIL)(WHILE(NOT QG$)(INITGET 1)(PRINC"\nSelect entity from the new ")(SETQ QG$(CAR(ENTSEL QGOj))))(SETQ QG?%(QGj1(ENTGET QG$)8))(PRINC"\nNew ")(PRINC QGOj)(PRINC" selected: ")(PRINC QG?%)(SETQ QG?% QG?%))(PRINC"54321")(DEFUN QG@O(QGOj)(SSADD))(DEFUN QG&$(QGj%)(PRINC"<<")(PRINC QGj%)(PRINC">>")(PRINC" -- String ignored")(SETQ QGj%"?"))(DEFUN QG@%(QGQ# QG| QG@j)(PRINC))(DEFUN ENTER-GEOM(QGQ# QG$ QG&Q QG@Q QGO@ QG%@ / QG0@ QGlQ)(IF(COND((= QG&Q"LINE")(QG&# QGQ# QG@Q(quote (10 11 6))T))((= QG&Q"ARC")(QG&# QGQ# QG@Q(quote (10 40 50 51 6))T))((= QG&Q"CIRCLE")(QG&# QGQ# QG@Q(quote (10 40 6))T))((= QG&Q"POLYLINE")(PRINC"\nPolylines not supported in this version.  See REGISTER.DOC")(PRINC))((= QG&Q"SOLID")(PRINC"\nExploded dimensions not supported in this version.  See REGISTER.DOC")(PRINC))((= QG&Q"DIMENSION")(SETQ QGlQ NIL)(IF QGO@(SETQ QGlQ(SSMEMB QG$ QGO@)))(SETQ QG?$(QG1$ QGQ# QG@Q QG?$ QGlQ)))(T(SETQ QGjQ NIL)))(PROGN(SETQ QG%@(1+ QG%@))(PRINC"\n"QGQ#)(IF(> QG%@ 40)(PROGN(PRINC"\nWarning: Too many entities in the parent geometry")(PRINC"\nLimit for the Shareware version exceeded")(CLOSE QGQ#)(GETPOINT"\nCan not proceed further...Press CTRL-C to abort")))))(SETQ QG%@ QG%@))(PRINC"0")(IF *PGPG-10*(SETQ QGQO ENTGET QGl$ ENTMOD)(SETQ QG&& QGO|))(PRINC"...loaded.")(WRITE-CHAR 7)(QG0| *PGPG-DIR*)(PRINC"\nCurrent Dimension  layer: ")(PRINC *DIM-LAYER*)(PRINC"       Center line layer: ")(PRINC *CEN-LAYER*)(IF(/=(STRCASE(GETVAR"MENUNAME"))(STRCASE(STRCAT *PGPG-DIR*"pgmenu")))(PROGN(PRINC"\nEnter the command: PGPGSET to change the layer settings.")(PRINC"\nEnter the command: PARENT to specify the parent geometry.")))(PRINC)